# $Id: Form.pm,v 1.9 2004/06/21 12:12:30 ibo Exp $
package CGI::FOGE2::Form;

require 5.006;

use CGI::FOGE2;

use CGI::FOGE2::Tools;
use CGI::FOGE2::FormStats;
use CGI::FOGE2::FormStatsParFiche;
use CGI::FOGE2::FilterFormStats;
use CGI::FOGE2::FilterGen;
use CGI::FOGE2::Filter;
use CGI::FOGE2::View;
use CGI::FOGE2::ViewGenerator;
use CGI::FOGE2::Fichegen;
use CGI::FOGE2::Fiche;

use POSIX qw(strftime);
use CGI::Carp qw(fatalsToBrowser set_message);
#use CGI::Pretty qw(-no_xhtml :standard);
use CGI qw(-no_xhtml :standard);

# includes that the caller will need.
use CGI::FOGE2::Section;
use CGI::FOGE2::Question;

use strict;
our @ISA = ();
our $instance = undef;

=head1 NAME

Form -- the design of the main form.

=head1 DESCRIPTION

The CGI::FOGE2::Form class defines the content of a poll. Within a
form are sections (see CGI::FOGE2::Section), sections are sequences of
questions (see CGI::FOGE2::Question). A question defines how it is
asked, how it should be answered, how answers are recorded in the
database, how answers will be culled when displaying statistics. The
definition of the form is the single object that is used for all these
aspects including the generation of SQL for the creation of the tables
that will record the answers. 

Mandatory parameters for C<new>:

=over 4

=item * title

Name of the form, will become the page title. 

=item * enquiry

A string that identifies the form. It will be used when joining the
tables together. Using a descriptive string is recommended. Polls that
are simultaneously active (and share some sql tables) should differ on
their enquiry strings.

=item * dbName

Name of the database to connect to, in DBI format.

=item * dbWriterLogin, dbWriterPass, dbReaderLogin, dbReaderPass

Identification data. Two different users can be used, one is allowed
to insert data in the tables, the other one can only read them.

=back

Optional parameters:

=over 4

=item * introduction, conclusion

Arbitrary text that will be displayed, respectively, at the top and at
the bottom of the form.

=item * ipMask

A regular expression. If present, then the client's IP number must
match this value to be allowed to access the form.

=item * submit

String displayed on the submit button.

=item * submit_date0, submit_date1

Setting one or both of these dates limits the availability of the form
in time. Access will be denied before submit_date0 and after
submit_date1.

=item * stats_date0

If set, the stats won't be visible before this date. 

=item * dbAnswer

An alternate table to use instead of the default C<answer>. This table
identifies answers for the currently active polls.

=item * ignorelag

Answers to the poll that come from the same IP and that are separated
by less than this number of seconds will be ignored (only the first
record of each set is kept). This is to cope with users who
frantically click on the submit button several times.

=item * greet

A "thank you" string that will be presented to users who successfully
submitted the form.

=item * css

Name of the stylesheet to use. Allows one to customize the way the
form looks to a fair extent. A sample CSS comes with the FOGE
distribution, adjust it to suit your needs.

=back

=cut

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my %args = @_;

    my @mandatory_keys = 
        ('title', 'enquiry',    # 'sections',
         'dbName', 'dbWriterLogin', 'dbWriterPass',
         'dbReaderLogin', 'dbReaderPass');
    my $self  =
    {
        title           => undef,
        enquiry         => undef, # The identifier for this poll

        introduction    => undef,
        conclusion      => undef,
        ipMask          => '.*', # Accept any IP number by default
        submit          => msg->vote,
        # array of CGI::FOGE2::Section objects
        sections        => undef,
        # array of stats objects for the whole Form:
        stats           => [CGI::FOGE2::FormStats->new(), ],
	#filter_stats    => [CGI::FOGE2::FilterFormStats->new()],

	# array of filter objects thtat will filter the
	# output of descendents of the FilterStats class
	#filters => [CGI::FOGE2::Filter->new()],

        ## Time management
        # Don't accept answers before, after these two dates:
        submit_date0    => undef,
        submit_date1    => undef,
        # Don't show statistics before this date:
        stats_date0     => undef,
        # SQL database to be used:
        dbName          => undef,
        dbAnswer        => 'foge_answer', # stores ids, IPs, etc
        dbReaderLogin   => undef,
        dbReaderPass    => undef,
        dbWriterLogin   => undef,
        dbWriterPass    => undef,
        dbTrace         => 0,

        # URL password (if defined, must be provided to see stats):
        URLpw           => undef,

        keyTable        => undef,
        keyProlog       => '',
        keyEpilog       => '',

        # 
        author          => undef,
        css             => undef,
        pagefooter      => '',
        scriptversion   => undef,
        content_type    => 'text/html; charset=ISO-8859-1',
        greet           => msg->greet,
        bof             => '-?-',
        ignorelag       => undef,
    };

    # Write the hash values we received into $self
    foreach my $key (keys %args) {
        # Check that the hash we receive only has key names
        # we know about
        if (exists $self->{$key}) {
            $self->{$key} = $args{$key};
        } else {
            # Don't complain if there are too many parameters. This is
            # needed for subclass constructors:
            #die(sprintf 'Form->new: '.msg->die_badkey, $key);
        }
    }


    # Check that all mandatory keys are present
    foreach my $key (@mandatory_keys) {
        if (!defined $self->{$key}) {
            die(sprintf 'Form->new: '.msg->die_missingkey, $key);
        }
    }

    # private attributes
    $self->{db_handle_r} = undef;
    $self->{db_handle_w} = undef;
    $self->{unique_id} = undef;
    $self->{dbAnswerSeq} = sprintf "%s_id_seq", $self->{dbAnswer};

    $self->{http_headers} = {-cost => "EUR 0.00047564",
                             # -expires => "+2h",
                             -expires => 'now',
                             -content_type => $self->{content_type}
                         };
    {
        my %html_head =
            (
             -title => $self->{title},
             -meta => { 'Content-Type' => $self->{content_type} },
             );
        if (defined $self->{author}) {
            $html_head{-author} = $self->{author};
        }
        if (defined $self->{css}) {
            $html_head{-style} = { src => $self->{css} };
        }
        $self->{html_head} = \%html_head;
    }

    # relate stats object and the current form:
    foreach my $stats (@{$self->{stats}}) {
        $stats->setform($self);
    }
    # relate filter objects and the current form:
    foreach my $filter (@{$self->{filters}}) {
        $filter->setform($self);
    }
    foreach my $fstat (@{$self->{filter_stats}}) {
        $fstat->setform($self);
    }

    bless ($self, $class);
    return $instance = $self;
}

# Try to have nicer error messages.

BEGIN {
    sub produce_error_message {
        my $msg = shift;
        if ( defined $instance ) {
            my $self = $instance;
            my $out = CGI::start_html($self->{html_head});
            $out .= CGI::h1($self->{title});
            $out .= CGI::p({ -class => 'formerror'}, $msg);
            $out .= $self->generate_foge_footer();
            $out .= CGI::end_html() . "\n";
            print $out;
        } else {
            # Minimum error message
            print "<h1> Problem </h1>
Error message: <tt>$msg</tt>
";
        }
    }

    set_message(\&produce_error_message);
}


sub addsection {
    my $self = shift;
    push @{$self->{sections}}, @_;
}

sub main {
    my $self = shift;

    $self->finalize();
    my $action = CGI::param('action'); 

    if (defined $action) {
        $self->handle_action($action);
    } else {
        $self->serve();
    }
}

sub handle_action {
    my $self = shift;
    my $action = shift;

    if ($action eq 'serve') {
        $self->serve();
    } elsif ($action eq $self->{submit}) {
        $self->handle_submission();
    } elsif ($action eq 'makesql') {
        $self->make_sql_structure();
    } elsif ($action eq 'printtablenames') {
        $self->print_sql_table_names();
    } elsif ($action =~ /^(see|peepingtom)$/) {
        $self->print_stats();
    } elsif ($action =~ /^printastext$/) {
        $self->print_text(0);
    } elsif ($action =~ /^printastextshort$/) {
        $self->print_text(1);
    } elsif ( $action =~ /^StatusRSS$/ ) {
        # Be user-friendly if some XML libraries are absent:
        eval {
            require CGI::FOGE2::StatusRSS;
            CGI::FOGE2::StatusRSS::generate_status($self);
        };
        die sprintf msg->die_badaction, $action 
            if $@;
    } elsif ($action =~ /^choose$/ ) {
        $self->choose_action();
    } elsif ($action =~ /^choosefilter$/) {
	$self->serveFilters();	
    } elsif ($action =~ /^advstats$/) {
	$self->adv_stats();
    } elsif ($action =~ /^viewgen$/) {
	$self->serveViewGen();
    } elsif ($action =~ /^fpfgen$/) {
	$self->serveFPFGen();
    } elsif ($action =~ /^fpf$/) {
	$self->fpf();
    } else {
        die sprintf msg->die_badaction, $action;
        die("Not implemented");
    }
}

# Generate a page that displays possible actions.

sub choose_action {
    my $self = shift;

    if ( !CGI::https() ) {
        die sprintf msg->die_nonauthenticatedperson;
    };
    print
        CGI::header($self->{http_headers}),
        CGI::start_html($self->{html_head}),
        "<div class='FOGE2'>\n",
        CGI::p(),
        # a etoffer, mettre en anglais, etc.
        CGI::table({-align => 'center'}, 
           CGI::Tr([CGI::td("<a href='?action=serve'>serve</a>"),
                    CGI::td("<a href='?action=StatusRSS'>StatusRSS</a>"),
                    ])),
        "</div>",
        CGI::end_html();
}

sub serveFilters {
    my $self = shift;
    my $view = CGI::FOGE2::View->new( form => $self );
    $self->{view} = $view;

    my $out = CGI::header($self->{http_headers});
    $out .= CGI::start_html($self->{html_head});
    $out .= "<div class='FOGE2'>";
    $out .= CGI::start_form('post', CGI::self_url());
    print $out;
    
    my $fg = CGI::FOGE2::FilterGen->new(form => $self);
    print $fg->serve();

    $out = submit( -name  => 'action', 
                   -value => 'advstats',
                   -class => 'formsubmit');

    $out .= submit( -name  => 'action', 
                    -value => 'fpfgen',
                    -class => 'formsubmit');

    $out .= submit( -name  => 'action', 
                    -value => 'viewgen',
                    -class => 'formsubmit');

    $out .= $view->as_hidden();

    $out .= CGI::end_form();        
    $out .= $self->generate_foge_footer();
    $out .= "</div>\n";
    $out .= end_html() . "\n";
    print $out;
}

sub serveFPFGen {
    my $self = shift;
    my $view = CGI::FOGE2::View->new( form => $self );
    $self->{view} = $view;

    my $filter = CGI::FOGE2::Filter->new(form => $self);
    $self->{filter} = $filter;
    $filter->create_temp_table();

    my $fg = CGI::FOGE2::Fichegen->new( form => $self );

    my $out = CGI::header($self->{http_headers});
    $out .= CGI::start_html($self->{html_head});
    $out .= "<div class='FOGE2'>";

    $out .= CGI::h1("Liste des fiches de: " . $self->{title});

    print $out;
    print $fg->serve();

    $out = $self->generate_foge_footer();
    $out .= "</div>\n";
    $out .= end_html() . "\n";
    print $out;
}

sub fpf {
    my $self = shift;
    $self->{view} = CGI::FOGE2::View->new( form => $self );
    my $id = CGI::param('id');
    my $fiche = CGI::FOGE2::Fiche->new
	( form => $self,
	  id => $id,
	  );
    
    my $out = CGI::header($self->{http_headers});
    $out .= CGI::start_html(-title => "Fiche $id",
			    -style => $self->{css},
			    );
    $out .= "<div class='FOGE2'>";

    print $out;
    print $fiche->serve();

    $out = $self->generate_foge_footer();
    $out .= "</div>\n";
    $out .= end_html() . "\n";
    print $out;

}

sub serveViewGen {
    my $self = shift;
    my $filter = CGI::FOGE2::Filter->new( form => $self);

    my $vg = CGI::FOGE2::ViewGenerator->new( form => $self );

    my $out = CGI::header($self->{http_headers});
    $out .= CGI::start_html
	( -title => "Configuration de la vue",
	  -meta => {'Content-Type' => 'text/html; charset=ISO-8859-1'},
	  -style => $self->{css},
	  );
    $out .= "<center><div class='FOGE2'>";
    $out .= CGI::start_form('post', CGI::self_url());
    print $out;
    
    print $vg->serve();

    $out = CGI::p();
    $out .= CGI::hr();
    $out .= CGI::submit(-name => 'action', 
                  -value => 'choosefilter',
                  -class => 'formsubmit');

    $out .= CGI::submit(-name => 'action', 
                  -value => 'advstats',
                  -class => 'formsubmit');

    $out .= CGI::submit(-name => 'action', 
                  -value => 'fpfgen',
                  -class => 'formsubmit');

    $out .= $filter->as_hidden();

#########################
    $_ = $filter->as_hidden(); s/></>\n</g;
    print STDERR 'THE FILTERRRR ISSSSS ->', $_;
    $_ = $filter->as_text(); s/></>\n</g;
    print STDERR 'THE FILTERRRR TEXTTT ->', $_;
########################


    $out .= CGI::hidden(-name => 'configview');

    $out .= CGI::end_form();
    $out .= CGI::p();
    $out .= $self->generate_foge_footer();
    $out .= "</div></center>";
    $out .= CGI::end_html();
    print $out, "\n";
}

sub serve {
    my $self = shift;
    my $time = time();

    ## Check access restrictions
    # IP restrictions
    $self->check_host_restrictions();
    # time restrictions
    $self->check_time_restrictions(right => 'answer', time => $time);

    ## do_it
    my $out = CGI::header($self->{http_headers});
    $out .= CGI::start_html($self->{html_head});
    # Wrap all FOGE2 CSS classes within class FOGE2:
    $out .= "<div class='FOGE2'>";
    $out .= CGI::start_form('post', CGI::self_url() # removed "?t=$time"
                           );
    $out .= CGI::h1($self->{title});

    if (defined $self->{introduction}) {
        $out .= CGI::p() . CGI::span({-class => 'formhead'},
                                     $self->{introduction});
    }
    $out .= CGI::p();
    print $out;

    # to do for vote forms (that use a key)
    if (defined (my $keytable = $self->{keyTable})) {
        $out = '';
        my $keyname = defined $self->{keyName}
          ? $self->{keyName} : $keytable;

        my $default = $self->get_one_key(); # gets one of the keys: 'dab7-75wq'
        $default =~ s/([\w\d])/?/g; # 'dab7-75wq' -> '????-????'
        my $length = length $default; # '????-????' -> 9
        $out = $self->{keyProlog};
        $out .= textfield(-name =>    $keyname,
                          -default => $default,
                          -size =>    $length);
        $out .= $self->{keyEpilog};
        print $out;
    }

    foreach my $section (@{$self->{sections}}) {
        print $section->serve();
    }

    $out = submit(-name => 'action', 
                  -value => $self->{submit},
                  -class => 'formsubmit');
    $out = sprintf p().hr(). "<center>%s</center>", $out;
    $out .= endform() . p() .
      span({-class=>'formfoot'}, $self->{conclusion}) . p();
    $out .= $self->generate_foge_footer();
    $out .= "</div>\n";
    $out .= end_html() . "\n";
    print $out;
}

sub generate_foge_footer {
    my $self = shift;
    my $out = '';
    $out .= hr();
    $out .= sprintf '<tt>%s</tt><br />', $self->{scriptversion} 
	if defined $self->{scriptversion};
    $out .= small(sprintf msg->servedbyfoge2, $CGI::FOGE2::VERSION);
    $out .= $self->{pagefooter} if defined $self->{pagefooter};
    return $out;
}


sub get_one_key { # private
    my $self = shift;
    # returns a vote key (which will be used as a template for the form)
    # TODO: use a db query instead of a hardcoded string
    return 'dab7-75wq';
}

sub handle_submission {
    my $self = shift;

    ## Check access restrictions
    # IP restrictions
    $self->check_host_restrictions();
    # time restrictions
    $self->check_time_restrictions(right => 'answer', time => time());

    my $db = $self->dbh_w();
    die msg->die_nodbhandle unless defined $db; # extraneous

    ## verbose output to the http server's log
    $db->trace($self->{dbTrace}) if $self->{dbTrace};

    my $out = header($self->{http_headers});
    $out .= start_html($self->{html_head});
    # $out .= h1(sprintf msg->title_submit_ok, $self->{title});

    # Check that the votekey may be used:
    my $id = $self->unique_id();
    my $enquiry = $self->{enquiry};

    if ( defined $self->{keyTable} ) {
        my $keytable = $self->{keyTable};
        my $keyname = defined $self->{keyName}
          ? $self->{keyName} : $keytable;
        my $request = "update $keytable 
set id = ?
where votekey = ?
  and enquiry = ?
  and id is null;";
        my $sth = $db->prepare($request)
          || die "Cannot prepare update request: " . $db->errstr;
        my $count = $sth->execute($id, CGI::param($keyname), $enquiry)
          || die "Cannot run update request: " . $db->errstr;
        die sprintf msg->die_used_votekey if $count==0;
        $sth->finish();
    };

    # my $allIsOK = 1;

    # my $dbh = open_db_connection_for_update($forms);
    # my $db = $self->dbh_w();

    # Check if this is a legal vote.
    #### NOTA: may use https to restrict votes submitted by a same person ???
    #### see this later ###
    #    my $keyTable = $self->{'keyTable'};
    ##    if ( defined($keyTable) ) {
    ##        my $request = "update $keyTable
    ##set id = ?
    ##where votekey = ?
    ##  and enquiry = '$enquiry'
    ##  and id is null
    ##;";
    ##        my $sth = $dbh->prepare($request)
    ##            || die "Cannot prepare insertkey request: " . DBI::errstr;
    ##        my $keyName = $forms->{'keyName'};
    ##        $keyName = $keyTable unless defined($keyName);
    ##        my $count = $sth->execute($id, param($keyName))
    ##            || die "Cannot execute insertkey request: " . DBI::errstr . "
    ##Auriez-vous omis d'indiquer une cl�?
    ##Auriez-vous commis une erreur en recopiant la cl�?
    ##N'auriez-vous pas d��r�ondu au questionnaire ? ";
    ##        die "Clef non trouv� ou usag�." if $count == 0;
    ##        $sth->finish();
    ##    };
    my $answerTable = $self->{dbAnswer};

    my $who = CGI::https() ? CGI::remote_user() : undef;

    # Record the global characteristics of the answer:
    my $request = "insert into $answerTable(id, ip, enquiry, remote_user) "
        ."values(?, ?, ?, ?);";
    my $sth = $db->prepare($request)
        || die "Cannot prepare insert0 request: " . $db->errstr;
    $sth->execute($id, remote_addr(), $enquiry, $who)
        || die "Cannot execute insert0 request: " . $db->errstr . "\n"
	    . "This may be due two a temporary glitch, please try again.";
    $sth->finish();

    # Call all section handlers, so as to know all error messages
    my ($allok, $errmsg, $errmsgsec) = (1, '', '');
    foreach my $section (@{$self->{sections}}) {
        if (!$section->handle_submission()) {
            $allok = 0;
            $errmsgsec = $section->errormsg();
            # $errmsg =~ s/\n/<br>/g;

            $errmsg .= sprintf("%s%s\n", 
                               h2({-class => 'sectitle'}, 
                                  $section->{title}), ul($errmsgsec));

            # this stops at the end of the first section that has a
            # bad answer
            # last;
        }
    }

    if ($allok) {
        $db->commit() || die sprintf msg->die_errorcommit, $db->errstr;
        $out .= h1(sprintf msg->title_submit_ok, $self->{title});
        $out .= $self->{greet};

    } else {
        $db->rollback;
        $out .= h1(sprintf msg->title_submit_fail, $self->{title});
        $out .= p({ -class => 'formerror' }, 
                  (sprintf msg->title_submit_fail_notice));
        $out .= $errmsg;
    }

    $db->disconnect;
    $out .= $self->generate_foge_footer();
    print $out;
}

sub dbh_r {
    ## returns a DB handle for reading (created only when needed)
    my $self = shift;

    if (!$self->{db_handle_r}) {
        $self->{db_handle_r} = $self->db_connect(0, 1);

        # select only the data pertaining to the right enquiry
        #$self->select_pertinent_answers($self->{db_handle_r});
    }
    return $self->{db_handle_r};
}

sub dbh_w {
    ## returns a DB handle for writing (created only when needed)
    my $self = shift;

    if (!$self->{db_handle_w}) { 
        $self->{db_handle_w} = $self->db_connect(1, 0);
    }
    return $self->{db_handle_w};
}

sub db_connect {                # private
    # Args: boolean (write, /read), boolean (autocommit, /transaction)
    # Opens a DB connection for reading/writing
    # and returns the resulting DB handle
    # returns or dies
    my $self = shift;
    my ($dowrite, $autocommit) = @_;

    # choose the proper user name and password
    my ($dbLogin, $dbPass);
    {
        my $rw = $dowrite ? 'Writer' : 'Reader';
        $dbLogin = $self->{"db${rw}Login"};
        $dbPass  = $self->{"db${rw}Pass"};
    }

    my $dbh = DBI->connect($self->{dbName}, $dbLogin, $dbPass,
                           { AutoCommit => $autocommit })
        || die sprintf msg->die_cannotconnect, $DBI::errstr;
    return $dbh;
}

sub select_pertinent_answers {
    my $self = shift;
    my ($dbh) = @_;

    # this syntax is PostgreSQL-specific
    my $sql = 'create temp table %s as  '
        .'select * '
        .'from %s answer '
        .'where answer.enquiry = \'%s\'';

    my $answertable = $self->{dbAnswer};
    my $tempanstable = $answertable; # the temp table name hides 'answer'

    $sql = sprintf $sql,
    $tempanstable, $answertable, $self->{enquiry};

    my $sth = $dbh->prepare($sql)
        || die "Cannot prepare answer-temp-create request: " . $dbh->errstr;
    $sth->execute()
        || die "Cannot execute answer-temp-create request: " . $dbh->errstr;
    $sth->finish();
}

sub check_host_restrictions {
    # returns or dies
    my $self = shift;
    my $ip = CGI::remote_addr();

    if (defined $self->{ipMask} && !($ip =~ $self->{ipMask})) {
        die sprintf msg->die_badipnumber, $ip;
    }
}

sub check_time_restrictions {
    # returns or dies

    my $self = shift;
    my %attribs = @_;
    my $time= $attribs{time};
    my $timefmt = '%Y-%m-%d %H:%M:%S %Z';

    if ($attribs{right} eq 'answer') {
        if (defined($self->{submit_date0})
            && $time<$self->{submit_date0}) {
            die sprintf msg->die_tooearlyans,
              strftime($timefmt, localtime $self->{submit_date0});
        } elsif (defined($self->{submit_date1})
                 && $time>$self->{submit_date1}) {
            die sprintf msg->die_toolateans,
              strftime($timefmt, localtime $self->{submit_date1});
        }
    } elsif ($attribs{right} eq 'stats') {
        if (defined($self->{stats_date0})
            && $time<$self->{stats_date0}) {
            die sprintf msg->die_tooearlystat,
              strftime($timefmt, localtime $self->{stats_date0});
        } elsif (defined($self->{submit_date1})
                 && $time>$self->{submit_date1}) {
            die sprintf msg->die_toolateans,
              strftime($timefmt, localtime $self->{submit_date1});
        }
    } else {
        die "Not implemented";
    }
}


sub make_sql_structure {
    my $self = shift;

    my $fmt_createuser = "CREATE USER %s WITH PASSWORD '%s';\n";
    my $fmt_revoke = "REVOKE ALL ON %s FROM PUBLIC;\n";
    my $fmt_grant = "GRANT %s ON %s TO %s;\n";
    my $fmt_createseq = "CREATE SEQUENCE %s;\n";

    my $out = '';

    # create users
    $out .= "\n-- create users --\n";
    $out .= sprintf $fmt_createuser,
      $self->{dbReaderLogin}, $self->{dbReaderPass};
    if ($self->{dbReaderLogin} ne $self->{dbWriterLogin}) {
        $out .= sprintf $fmt_createuser,
          $self->{dbWriterLogin}, $self->{dbWriterPass};
    };

    my @relations = ($self->{dbAnswer});
    ## create relations
    $out .= "\n-- create relations --\n";
    # answer table
    my $sql_answerrelation = "    id          serial primary key,\n";
    $sql_answerrelation .=   "    t           timestamp "
      ."default current_timestamp,\n";
    $sql_answerrelation .=   "    ip          inet not null,\n";
    $sql_answerrelation .=   "    enquiry     text not null,\n";
    $sql_answerrelation .=   "    remote_user text null -- for HTTPS\n";
    $out .= sprintf "create table %s (\n%s);\n", $self->{dbAnswer},
      $sql_answerrelation;

    # Table for vote keys:
    if ( defined $self->{keyTable} ) {
        my $keytable = $self->{keyTable};
        my $read_user = $self->{dbReaderLogin};
        my $write_user = $self->{dbWriterLogin};
        my $request = "\n-- Table for vote keys
create table $keytable (
   enquiry  text not null,
   votekey  text not null,
   id       integer null -- refers foge_answer.id when not null
);
REVOKE ALL ON $keytable FROM PUBLIC;
GRANT select ON $keytable TO $read_user;
GRANT select, update ON $keytable TO $write_user;
\n";
        $out .= $request;
    };

    # answer id sequence
    #QNC: useless with Postgresql:
    #$out .= sprintf $fmt_createseq, $self->{dbAnswerSeq};

    # section-specific tables
    foreach my $section (@{$self->{sections}}) {
        $out .= sprintf $section->make_sql_structure(), $self->{dbAnswer};
        push @relations, $section->get_table_name();
    }

    # revoke - grant
    $out .= "\n-- revoke/grant --\n";
    my @rights = ({user => $self->{dbReaderLogin}, 
                   rights => 'select'},
                  {user => $self->{dbWriterLogin}, 
                   rights => 'select, insert'});

    foreach my $relation (@relations) {
        $out .= sprintf $fmt_revoke, $relation;
        foreach my $right (@rights) {
            $out .= sprintf $fmt_grant, $right->{rights}, $relation, 
              $right->{user};
        }
    }

    # revoke - grant for the sequence
    my $seq = $self->{dbAnswerSeq};
    $out .= sprintf $fmt_revoke, $seq;
    $out .= sprintf $fmt_grant,
      'select, update', $seq, $self->{dbWriterLogin};

    print $out;
}

sub print_sql_table_names {
    my $self = shift;
    printf "%s\n", $self->{enquiry};
    printf "%s\n", join "\n", @{$self->get_sql_table_names};
}

sub get_sql_table_names {
    my $self = shift;
    my $sections = $self->{sections};
    my @tables = ($self->{dbAnswer});
    foreach my $section (@$sections) {
	push @tables, $section->get_sql_table_name();
    }
    return \@tables;
}

sub unique_id {
    # returns the submission's unique ID (the same for all successive calls)
    my $self = shift;
    if (!defined $self->{unique_id}) {
        my $id;
        my $db = $self->dbh_w();
        my $query = sprintf "select nextval('%s')", $self->{dbAnswerSeq};
        my $sth = $db->prepare($query)
          || die "oups: prepare getseq\n" . $db->errstr;
        $sth->execute()
          || die "oups: execute getseq\n" . $sth->errstr;
        ($id) = $sth->fetchrow_array()
          || die "oups: select getseq\n" . $sth->errstr;
        $self->{unique_id} = $id;
    }
    return $self->{unique_id};
}

sub get_bof {
    my $self = shift;
    return $self->{bof};
}

sub getview {
    my $self = shift;
    return $self->{view};
}

sub print_stats {
    my $self = shift;
    my $time = time();
    ## Check access restrictions
    # IP restrictions
    $self->check_host_restrictions();
    # time restrictions
    $self->check_time_restrictions(right => 'stats', time => $time);


    $self->{view} = CGI::FOGE2::View->new( form => $self );
    my $view = $self->{view};

    my $out = header($self->{http_headers});
    $out .= CGI::start_html($self->{html_head});
    # Wrap all FOGE2 CSS classes within class FOGE2:
    $out .= "<center><div class='FOGE2'>\n";

########## BRICOLAGE ############
    $out .=  CGI::start_form('post', CGI::url({-query => 0}));
#################################

    $out .= h1(sprintf msg->title_stats, $self->{title});
    my $msgs = '';
    # First display global form statistics:
    foreach my $stat (@{$self->{stats}}) {
        $msgs .= $stat->getstats();
    }

    #$filter->finish();
    
    # Then iterate on each section:
    foreach my $section (@{$self->{sections}}) {
	my $secname = $section->get_table_name();
	next unless $view->contains_section($secname);

	my $m .= CGI::checkbox( -name => 'showsec_' . $section->{table},
				-on => 1,
				-label => '',
				);
	$m .= $section->{title};
        $msgs .= h2({-class => 'sectitle'}, $m);
        $msgs .= $section->getstats();
    }

    $out .= $msgs;

########## BRICOLAGE ############

    #$out .= $view->as_hidden();

    $out .= submit(-name => 'action', 
                  -value => 'see',
                  -class => 'formsubmit');
    $out .= CGI::end_form();    
#################################

    $out .= $self->generate_foge_footer();
    $out .= "</div></center>\n";
    $out .= end_html() . "\n";
    print $out;
}


###########################################################
#   ADVANCED STATISTIQUES
###########################################################
sub adv_stats {
    my $self = shift;
    my $view = CGI::FOGE2::View->new( form => $self );
    $self->{view} = $view;
    my $filter = CGI::FOGE2::Filter->new( form => $self);
    $self->{filter} = $filter;
    $filter->create_temp_table();

    my $out = header($self->{http_headers});
    $out .= CGI::start_html($self->{html_head});
    $out .= "<center><div class='FOGE2'>\n";

    $out .=  CGI::start_form('post', CGI::url());
    $out .= h1(sprintf msg->title_stats, $self->{title});
    my $msgs = '';

    foreach my $stat (@{$self->{stats}}) {
        $msgs .= $stat->getstats();
    }

    foreach my $section (@{$self->{sections}}) {
	my $secname = $section->get_table_name();
	next unless $view->contains_section($secname);

	my $m .= CGI::checkbox( -name => 'showsec_' . $section->{table},
				-on => 1,
				-label => '',
				);
	$m .= $section->{title};
        $msgs .= h2({-class => 'sectitle'}, $m);
        $msgs .= $section->getstats();
    }
    $out .= $msgs;
    $out .= submit(-name => 'action', 
		   -value => 'advstats',
		   -class => 'formsubmit');

    $out .= $filter->as_hidden();
    $out .= CGI::end_form();    
    $out .= $self->generate_foge_footer();

    $out .= CGI::pre($filter->as_hidden());

    $out .= "</div></center>\n";
    $out .= end_html() . "\n";
    print $out;
}

################################################################
################################################################
################################################################

sub filtered_stats {
    my $self = shift;
    my $filter = CGI::FOGE2::Filter->new(form => $self);
    $self->{filter} = $filter;

    my $out = header($self->{http_headers});
    $out .= CGI::start_html($self->{html_head});
    $out .= "<center><div class='FOGE2'>\n";
    print $out;
    #print $filter->as_text();
    
    print CGI::h5($filter->as_sql());
    print $filter->as_hidden();
    my $fg = CGI::FOGE2::Fichegen->new( form => $self );
    print $fg->serve();

    $out = $self->generate_foge_footer();
    $out .= "</div></center>\n";
    $out .= end_html() . "\n";
    print $out;
}

sub finalize {
    my $self = shift;
    # Completes the initialization of some objects

    foreach my $section (@{$self->{sections}}) {
        $section->finalize();
    }
}

sub print_text {
    my $self = shift;
    my ($shortformat) = @_;
    print $self->as_text($shortformat);
}

sub as_text {
    my $self = shift;
    my ($shortformat) = @_;
    my $out = '';
    my $i = 0;

    $out .= sprintf "--- %s ---\n\n", $self->{title};

    $out .= $self->stringwrap($self->{introduction}) unless $shortformat;

    foreach my $section (@{$self->{sections}}) {
        $out .= $section->as_text([++$i], ' ' x 4, $shortformat);
    }

    $out .= "\n";
    $out .= $self->stringwrap($self->{conclusion}) unless $shortformat;

    return $out;
}

sub stringwrap {
    my $self = shift;
    # string -> string
    # string, string -> string
    # undef -> ''
    # Returns the given string formatted with no more than 50
    # characters per line. Each line is indented by the the second
    # string, if provided.

    my ($str, $indent) = @_;
    $indent ||= '';

    if (!defined $str) { return '' };

    $str =~ s/(.{50}\S*?)\s/$1\n$indent| /g;
    $str = $indent . '| ' . $str . "\n\n";
    return $str;
}

1;
